home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DIRS.SWG / 0022_Files Wildcard Matching.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  13KB  |  388 lines
  1. (* -------------------------------------------------------------- *)
  2. (* FileSpec.PAS v1.0a by Robert Walking-Owl November 1993         *)
  3. (* -------------------------------------------------------------- *)
  4.  
  5. { Things to add...                                                 }
  6. { - have # and $ be symbols for ASCII chars in dec/hex?            }
  7.  
  8. (* Buggie Things:                                                 *)
  9. (* - anti-sets don't work with variable lenght sets, since they   *)
  10. (*   end with the first character NOT in the set...               *)
  11.  
  12. {$F+}
  13.  
  14. unit FileSpec;
  15.  
  16. interface
  17.  
  18. uses Dos;
  19.  
  20. const
  21.   DosNameLen  = 12;     (* Maximum Length of DOS filenames        *)
  22.   UnixNameLen = 32;     (* Maximum Length of Unix Filenames       *)
  23.  
  24.   MaxWildArgs = 32;     (* Maximum number of wildcard arguments   *)
  25.   MaxNameLen  = 127;
  26.  
  27.   fCaseSensitive = $01; (* Case Sensitive Flag                    *)
  28.   fExtendedWilds = $02; (* Use extented wildcard forms (not,sets  *)
  29.   fUndocumented  = $80; (* Use DOS 'undocumented' filespecs       *)
  30.  
  31. type
  32.   SpecList   = array [1..MaxWildArgs] of record
  33.                    Name:  string[ MaxNameLen ];  (* or use DOS ParamStr?  *)
  34.                    Truth: Boolean
  35.                    end;
  36.   PWildCard  = ^TWildCard;
  37.   TWildCard  = object
  38.                  private
  39.                    FileSpecs: SpecList;     (* List of filespecs      *)
  40.                    NumNegs,                 (* Number of "not" specs  *)
  41.                    FSpCount:  word;         (* Total number of specs  *)
  42.                    function StripQuotes( x: string ): string;
  43.                    procedure   FileSplit(Path: string;
  44.                                    var Dir,Name,Ext: string);
  45.                  public
  46.                    PathChar,                (* path seperation char   *)
  47.                    NotChar,                 (* "not" char - init '~'  *)
  48.                    QuoteChar:     Char;     (* quote char - init '"'  *)
  49.                    Flags,                   (* Mode flags ...         *)
  50.                    FileNameLen:   Byte;     (* MaxLength of FileNames *)
  51.                    constructor Init;
  52.                    procedure   AddSpec( name: string);
  53.                    function    FitSpec( name: string): Boolean;
  54.                    destructor  Done;
  55.                (* Methods to RemoveSpec() or ChangeSpec() aren't added *)
  56.                (* since for most applications they seem unnecessary.   *)
  57.                (* An IsValid() spec to see if a specification is valid *)
  58.                (* syntax is also unnecessary, since no harm is done,   *)
  59.                (* and DOS and Unix ignore them anyway ....             *)
  60.                end;
  61.  
  62.  
  63. implementation
  64.  
  65. procedure UpCaseStr( var S: string); assembler;
  66. asm
  67.                 PUSH    DS
  68.                 LDS     SI,S
  69.                 MOV     AL,BYTE PTR DS:[SI]
  70.                 XOR     CX,CX
  71.                 MOV     CL,AL
  72. @STRINGLOOP:    INC     SI
  73.                 MOV     AL,BYTE PTR DS:[SI]
  74.                 CMP     AL,'a'
  75.                 JB      @NOTLOCASE
  76.                 CMP     AL,'z'
  77.                 JA      @NOTLOCASE
  78.                 SUB     AL,32
  79.                 MOV     BYTE PTR DS:[SI],AL
  80. @NOTLOCASE:     LOOP    @STRINGLOOP
  81.                 POP     DS
  82. end;
  83.  
  84.  
  85. constructor TWildCard.Init;
  86. begin
  87.   FSpCount  := 0;
  88.   NumNegs   := 0;
  89.   NotChar   := '~';
  90.   QuoteChar := '"';
  91.   Flags := fExtendedWilds or fUndocumented;
  92.   FileNameLen := DosNameLen;
  93.   PathChar := '\';
  94. end;
  95.  
  96. destructor TWildCard.Done;
  97. begin
  98.   FSpCount := 0
  99. end;
  100.  
  101. function TWildCard.StripQuotes( x: string ): string;
  102. begin
  103.   if x<>''
  104.     then if (x[1]=QuoteChar) and (x[length(x)]=QuoteChar)
  105.       then StripQuotes := Copy(x,2,Length(x)-2)
  106.       else StripQuotes := x
  107. end;
  108.  
  109. procedure TWildCard.AddSpec( Name: string);
  110. var
  111.   Truth: Boolean;
  112. begin
  113.   if Name <> '' then begin
  114.   Truth := True;
  115.   if (Flags and fExtendedWilds)<>0
  116.     then begin
  117.       if Name[1]=NotChar
  118.         then begin
  119.           inc(NumNegs);
  120.           Truth := False;
  121.           Name  := Copy( Name , 2, Pred(Length(Name)) );
  122.          end;
  123.       Name := StripQuotes( Name );
  124.     end;
  125.   if (FSpCount<>MaxWildArgs) and (Name<>'')
  126.     then begin
  127.       inc( FSpCount );
  128.       FileSpecs[ FSpCount ].Name := Name;
  129.       FileSpecs[ FSpCount ].Truth := Truth
  130.       end;
  131.   end
  132. end;
  133.  
  134. procedure TWildCard.FileSplit(Path: string; var Dir,Name,Ext: string);
  135. var
  136.   i,p,e: byte;
  137.   InSet: Boolean;
  138. begin
  139.   p:=0;
  140.   if (Flags and fCaseSensitive)=0
  141.     then UpCaseStr(Path);
  142.   for i:=1 to length(Path) do if Path[i]=PathChar then p:=i;
  143.   i:=Length(Path);
  144.   InSet := False;
  145.   e := succ(length(Path));
  146.   repeat
  147.     if not Inset
  148.        then case Path[i] of
  149.               '.': e := i;
  150.               ']',
  151.               '}',
  152.               ')': InSet := True;
  153.             end
  154.        else if Path[i] in ['[','{','('] then InSet := False;
  155.     dec(i);
  156.   until i=0;
  157.   if p=0
  158.     then Dir := ''
  159.     else Dir := Copy(Path,1,p);
  160.   Name := Copy(Path,Succ(p),pred(e-p));
  161.   if e<=length(Path)
  162.     then Ext := Copy(Path,e,succ(Length(Path)-e))
  163.     else Ext := '';
  164. end;
  165.  
  166. function TWildCard.FitSpec( name: string): Boolean;
  167.  
  168. procedure Puff(var x: string); (* Pad filename with spaces *)
  169. begin
  170.   while length(x)<FileNameLen do x:=x+' ';
  171. end;
  172.  
  173.  
  174. var x,b: set of char;
  175. procedure GetSet(s: string; EndSet: char; var k: byte);
  176. var
  177.     c: char;
  178.     u: string;
  179.     i: byte;
  180.     A: Boolean;
  181. begin
  182.   A := False;
  183.   if s[k]=',' then repeat
  184.       inc(k)
  185.     until (k>=FileNameLen) or (s[k]=EndSet) or (s[k]<>',');
  186.   u := '';
  187.   if (k<FileNameLen) and (s[k]<>EndSet) then begin
  188.     repeat
  189.       u := u + s[k];
  190.       inc(k);
  191.     until (k>=FileNameLen) or (s[k]=EndSet) or (s[k]=',');
  192.     if u<>'' then begin
  193.       if u[1]=NotChar
  194.         then begin
  195.           A := True;
  196.           u := Copy(u,2,pred(length(u)));
  197.           end;
  198.       u := StripQuotes(u);
  199.       if (length(u)=3) and (u[2]='-')
  200.         then begin
  201.            for c := u[1] to u[3]
  202.              do if A then b := b+[ c ]
  203.                    else x := x+[ c ]
  204.            end
  205.         else begin
  206.            for i:=1 to length(u)
  207.              do if A then b := b+[ u[i] ]
  208.                    else x:=x+[ u[i] ];
  209.            end
  210.     end;
  211.   end;
  212. end;
  213.  
  214. function Match(n,s: string): Boolean;  (* Does a field match? *)
  215. var i,j,k: byte;
  216.     c: char;
  217.     T: Boolean;
  218.     Scrap: string;
  219. begin
  220.   i := 1; (* index of filespec *)
  221.   j := 1; (* index of name     *)
  222.   T := True;
  223.   Puff(n);
  224.   Puff(s);
  225.   repeat
  226.     if s[i]='*' then i:=FileNameLen (* Abort *)
  227.       else
  228.          case s[i] of
  229.          '(' : if ((Flags and fExtendedWilds)<>0) then begin
  230.                  Scrap := '';
  231.                  inc(i);
  232.                  repeat
  233.                    Scrap := Scrap + s[i];
  234.                    inc(i);
  235.                  until (i>=FileNameLen) or (s[i]=')');
  236.                  Scrap := StripQuotes(Scrap);
  237.                  if Pos(Scrap,Copy(n,j,Length(n)))=0
  238.                    then T := False;
  239.                end;
  240.          '[' : if ((Flags and fExtendedWilds)<>0) then begin
  241.                 x := [];  b := [];
  242.                 k:=succ(i);
  243.                 repeat
  244.                   GetSet(s,']',k);
  245.                 until (k>=FileNameLen) or (s[k]=']');
  246.                 i := k;
  247.                 if x=[] then FillChar(x,SizeOf(x),#255);
  248.                 x := x-b;
  249.                 if not (n[j] in x) then T := False;
  250.                end;
  251.           '{' : if ((Flags and fExtendedWilds)<>0) then begin
  252.                   x := [];  b := [];
  253.                   k:=succ(i);
  254.                   repeat
  255.                    GetSet(s,'}',k);
  256.                   until (k>=FileNameLen) or (s[k]='}');
  257.                   i := succ(k);
  258.                   if x=[] then FillChar(x,SizeOf(x),#255);
  259.                   x := x-b;
  260.                   while (n[j] in x) and (j<=FileNameLen)
  261.                     do inc(j);
  262.                end;
  263.        else if T and (s[i]<>'?')
  264.           then if s[i]<>n[j] then  T := False;
  265.        end;
  266.     inc(i);
  267.     inc(j);
  268.   until (not T) or (s[i]='*') or (i>FileNameLen) or (j>FileNameLen);
  269.   Match := T;
  270. end;
  271.  
  272. var i,
  273.     NumMatches : byte;
  274.     dn,de,nn,ne,sn,se: string;
  275.     Negate : Boolean;
  276. begin
  277.   Negate := False;
  278.   if FSpCount=0 then NumMatches := 1
  279.     else begin
  280.       NumMatches := 0;
  281.       for i:=1 to FSpCount
  282.         do begin
  283.           FileSplit(name,dn,nn,ne);
  284.           FileSplit(FileSpecs[i].Name,de,sn,se);
  285.             if ne='' then ne:='.   ';
  286.           if (Flags and fUnDocumented)<>0 then begin
  287.             if sn='' then sn:='*';
  288.             if se='' then se:='.*';
  289.             if dn='' then dn:='*';
  290.             if de='' then de:='*';
  291.           end;
  292.           if (Match(dn,de) and Match(nn,sn) and Match(ne,se))
  293.              then begin
  294.                inc(NumMatches);
  295.                if not FileSpecs[i].Truth
  296.                   then Negate := True;
  297.                end;
  298.           end;
  299.       end;
  300.   if (NumNegs=FSpCount) and (NumMatches=0)
  301.     then FitSpec := True
  302.     else FitSpec := (NumMatches<>0) xor Negate;
  303. end;
  304.  
  305.  
  306. end.
  307.  
  308. {---------------------  DEMO ------------------------- }
  309.  
  310. (* Demo program to "test" the FileSpec unit                             *)
  311. (* Checks to see if file matches filespec... good for testing/debugging *)
  312. (* the FileSpec object/unit, as well as learning the syntax of FileSpec *)
  313.  
  314. program FileSpec_Test(input, output);
  315.   uses FileSpec;
  316. var p,                                       (* User-entered "filespec"  *)
  317.     d:  String;                              (* Filename to "test"       *)
  318.     FS: TWildCard;                           (* FileSpec Object          *)
  319. begin
  320.   FS.Init;                                   (* Initialize               *)
  321.   WriteLn;
  322.   Write('Enter filespec -> '); ReadLN(p);    (* Get filespec...          *)
  323.   FS.AddSpec(p);                             (* ... Add Spec to list ... *)
  324.   Write('Enter file -----> '); ReadLN(d);    (* ... Get Filename ...     *)
  325.   if FS.FitSpec(d)                           (* Is the file in the list? *)
  326.     then WriteLN('The files match.')
  327.     else WriteLN('The files don''t match.');
  328.   FS.Done;                                   (* Done... clean up etc.    *)
  329. end.
  330.  
  331.  
  332. FileSpec v1.0a
  333. --------------
  334.  
  335. "FileSpec" is a public domain Turbo Pascal unit that gives you advanced,
  336. Unix-like filespecs and wildcard-matching capabilities for your software.
  337. This version should be compatible with Turbo Pascal v5.5 upwards (since
  338. it uses OOP).
  339.  
  340. The advantage is that you can check to see if a filename is within the
  341. specs a user has given--even multiple filespecs; thus utilities like
  342. file-finders or archive-viewers can have multiple file-search specif-
  343. ications.
  344.  
  345. To use, first initialize the TWildCard object (.Init).
  346.  
  347. You then use .AddSpec() to add the wildcards (e.g. user-specified) to the
  348. list; and use .FitSpec() to see if a filename "fits" in that list.
  349.  
  350. When done, use the .Done destructor. (Check your TPascal manual if you do
  351. not understand how to use objects).
  352.  
  353. "FileSpec" supports standard DOS wilcards (* and ?); also supported are the
  354. undocumented DOS wildcards (eg. FILENAME = FILENAME.* and .EXT = *.EXT).
  355.  
  356. However, "FileSpec" supports many extended features which can make a program
  357. many times more powerful.  Filenames or wildcards can be in quotes (eg. "*.*"
  358. is equivalent to *.*).
  359.  
  360. Also supported are "not" (or "but") wildcards using the ~ character.  Thus
  361. a hypothetical directory-lister with the argument ~*.TXT would list all
  362. files _except_ those that match *.TXT.
  363.  
  364. Fixed and variable length "sets" are also supported:
  365.  
  366. [a-m]*.*           <- Any files beginning with letters A-M
  367. [a-z,~ux]*.*       <- Any files beginning with a any letter except X or U
  368. *.?[~q]?           <- Any files except those that match *.?Q?
  369. foo[abc]*.*        <- Files of FOO?*.* where '?' is A,B or C
  370. foo["abc"]*.*      <- Same as above.
  371. foo[a-c]*.*        <- Same as above.
  372. test{0-9}.*        <- Files of TEST0.* through TEST9999.*
  373. x{}z.*             <- Filenames beginning with X and ending with Z
  374. x{0123456789}z.*   <- Same as above, only with numbers between X and Z.
  375. ("read")*.*        <- Filenames that contain the text "READ"
  376.  
  377. If this seems confusing, use the FS-TEST.PAS program included with this
  378. archive to experiment and learn the syntax used by "FileSpec".
  379.  
  380. Playing around with the included demos (LS.PAS, a directory lister; and
  381. XFIND, a file-finder) will also give you an idea how to use the FileSpecs
  382. unit.
  383.  
  384. One Note: if you use the FileSpec unit with your software, please let users
  385. know about it in the documentation, so that they know they can take full
  386. advantage of the added features.
  387.  
  388.